home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / UNIXTOOL / GNU / TILEFORTH / TILE / TILE~ / !Tile / test / matrixmult < prev    next >
Text File  |  1991-08-10  |  1KB  |  52 lines
  1. .( Loading Matrix Multiplication benchmark...) cr
  2.  
  3. \ A classical benchmark of an O(n**3) algorithm; Matrix Multiplication
  4. \
  5. \ Part of the programs gathered by John Hennessy for the MIPS
  6. \ RISC project at Stanford. Translated to forth by  Marty Fraeman,
  7. \ Johns Hopkins University/Applied Physics Laboratory.
  8.  
  9. variable seed
  10.  
  11. : initiate-seed ( -- )  74755 seed ! ;
  12. : random  ( -- n )  seed @ 1309 * 13849 + 65535 and dup seed ! ;
  13.  
  14. 40 constant row-size
  15. row-size cells constant row-byte-size
  16.  
  17. row-size row-size * constant mat-size
  18. mat-size cells constant mat-byte-size
  19.  
  20. align create ima mat-byte-size allot
  21. align create imb mat-byte-size allot
  22. align create imr mat-byte-size allot
  23.  
  24. : initiate-matrix ( m[row-size][row-size] -- )
  25.   mat-byte-size bounds do
  26.     random dup 120 / 120 * - 60 - i !
  27.   cell +loop
  28. ;
  29.  
  30. : innerproduct ( a[row][*] b[*][column] -- int)
  31.   0 row-size 0 do
  32.     >r over @ over @ * r> + >r
  33.     cell+ swap row-byte-size + swap
  34.     r>
  35.   loop
  36.   >r 2drop r>
  37. ;
  38.  
  39. : matrix-mult  ( -- )
  40.   initiate-seed
  41.   ima initiate-matrix
  42.   imb initiate-matrix 
  43.   imr ima mat-byte-size bounds do
  44.     imb row-byte-size bounds do
  45.       j i innerproduct over ! cell+ 
  46.     cell +loop
  47.   row-size cells +loop
  48.   drop
  49. ;
  50.  
  51. forth only
  52.